home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / tests / trace.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  28.1 KB  |  967 lines  |  [TEXT/ALFA]

  1. # Commands covered:  trace
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright (c) 1991-1993 The Regents of the University of California.
  8. # Copyright (c) 1994 Sun Microsystems, Inc.
  9. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. #
  13. # SCCS: @(#) trace.test 1.27 97/07/23 17:08:38
  14.  
  15. if {[string compare test [info procs test]] == 1} then {source defs}
  16.  
  17. proc traceScalar {name1 name2 op} {
  18.     global info
  19.     set info [list $name1 $name2 $op [catch {uplevel set $name1} msg] $msg]
  20. }
  21. proc traceScalarAppend {name1 name2 op} {
  22.     global info
  23.     lappend info $name1 $name2 $op [catch {uplevel set $name1} msg] $msg
  24. }
  25. proc traceArray {name1 name2 op} {
  26.     global info
  27.     set info [list $name1 $name2 $op [catch {uplevel set [set name1]($name2)} msg] $msg]
  28. }
  29. proc traceArray2 {name1 name2 op} {
  30.     global info
  31.     set info [list $name1 $name2 $op]
  32. }
  33. proc traceProc {name1 name2 op} {
  34.     global info
  35.     set info [concat $info [list $name1 $name2 $op]]
  36. }
  37. proc traceTag {tag args} {
  38.     global info
  39.     set info [concat $info $tag]
  40. }
  41. proc traceError {args} {
  42.     error "trace returned error"
  43. }
  44. proc traceCheck {cmd args} {
  45.     global info
  46.     set info [list [catch $cmd msg] $msg]
  47. }
  48. proc traceCrtElement {value name1 name2 op} {
  49.     uplevel set ${name1}($name2) $value
  50. }
  51.  
  52. # Read-tracing on variables
  53.  
  54. test trace-1.1 {trace variable reads} {
  55.     catch {unset x}
  56.     set info {}
  57.     trace var x r traceScalar
  58.     list [catch {set x} msg] $msg $info
  59. } {1 {can't read "x": no such variable} {x {} r 1 {can't read "x": no such variable}}}
  60. test trace-1.2 {trace variable reads} {
  61.     catch {unset x}
  62.     set x 123
  63.     set info {}
  64.     trace var x r traceScalar
  65.     list [catch {set x} msg] $msg $info
  66. } {0 123 {x {} r 0 123}}
  67. test trace-1.3 {trace variable reads} {
  68.     catch {unset x}
  69.     set info {}
  70.     trace var x r traceScalar
  71.     set x 123
  72.     set info
  73. } {}
  74. test trace-1.4 {trace array element reads} {
  75.     catch {unset x}
  76.     set info {}
  77.     trace var x(2) r traceArray
  78.     list [catch {set x(2)} msg] $msg $info
  79. } {1 {can't read "x(2)": no such element in array} {x 2 r 1 {can't read "x(2)": no such element in array}}}
  80. test trace-1.5 {trace array element reads} {
  81.     catch {unset x}
  82.     set x(2) zzz
  83.     set info {}
  84.     trace var x(2) r traceArray
  85.     list [catch {set x(2)} msg] $msg $info
  86. } {0 zzz {x 2 r 0 zzz}}
  87. test trace-1.6 {trace array element reads} {
  88.     catch {unset x}
  89.     set info {}
  90.     trace variable x r traceArray2
  91.     proc p {} {
  92.         global x
  93.         set x(2) willi
  94.         return $x(2)
  95.     }
  96.     list [catch {p} msg] $msg $info
  97. } {0 willi {x 2 r}}
  98. test trace-1.7 {trace array element reads, create element undefined if nonexistant} {
  99.     catch {unset x}
  100.     set info {}
  101.     trace variable x r q
  102.     proc q {name1 name2 op} {
  103.         global info
  104.         set info [list $name1 $name2 $op]
  105.         global $name1
  106.         set ${name1}($name2) wolf
  107.     }
  108.     proc p {} {
  109.         global x
  110.         set x(X) willi
  111.         return $x(Y)
  112.     }
  113.     list [catch {p} msg] $msg $info
  114. } {0 wolf {x Y r}}
  115. test trace-1.8 {trace reads on whole arrays} {
  116.     catch {unset x}
  117.     set info {}
  118.     trace var x r traceArray
  119.     list [catch {set x(2)} msg] $msg $info
  120. } {1 {can't read "x(2)": no such variable} {}}
  121. test trace-1.9 {trace reads on whole arrays} {
  122.     catch {unset x}
  123.     set x(2) zzz
  124.     set info {}
  125.     trace var x r traceArray
  126.     list [catch {set x(2)} msg] $msg $info
  127. } {0 zzz {x 2 r 0 zzz}}
  128. test trace-1.10 {trace variable reads} {
  129.     catch {unset x}
  130.     set x 444
  131.     set info {}
  132.     trace var x r traceScalar
  133.     unset x
  134.     set info
  135. } {}
  136.  
  137. # Basic write-tracing on variables
  138.  
  139. test trace-2.1 {trace variable writes} {
  140.     catch {unset x}
  141.     set info {}
  142.     trace var x w traceScalar
  143.     set x 123
  144.     set info
  145. } {x {} w 0 123}
  146. test trace-2.2 {trace writes to array elements} {
  147.     catch {unset x}
  148.     set info {}
  149.     trace var x(33) w traceArray
  150.     set x(33) 444
  151.     set info
  152. } {x 33 w 0 444}
  153. test trace-2.3 {trace writes on whole arrays} {
  154.     catch {unset x}
  155.     set info {}
  156.     trace var x w traceArray
  157.     set x(abc) qq
  158.     set info
  159. } {x abc w 0 qq}
  160. test trace-2.4 {trace variable writes} {
  161.     catch {unset x}
  162.     set x 1234
  163.     set info {}
  164.     trace var x w traceScalar
  165.     set x
  166.     set info
  167. } {}
  168. test trace-2.5 {trace variable writes} {
  169.     catch {unset x}
  170.     set x 1234
  171.     set info {}
  172.     trace var x w traceScalar
  173.     unset x
  174.     set info
  175. } {}
  176.  
  177. # append no longer triggers read traces when fetching the old values of
  178. # variables before doing the append operation. However, lappend _does_
  179. # still trigger these read traces. Also lappend triggers only one write
  180. # trace: after appending all arguments to the list.
  181.  
  182. test trace-3.1 {trace variable read-modify-writes} {
  183.     catch {unset x}
  184.     set info {}
  185.     trace var x r traceScalarAppend
  186.     append x 123
  187.     append x 456
  188.     lappend x 789
  189.     set info
  190. } {x {} r 0 123456}
  191. test trace-3.2 {trace variable read-modify-writes} {
  192.     catch {unset x}
  193.     set info {}
  194.     trace var x rw traceScalarAppend
  195.     append x 123
  196.     lappend x 456
  197.     set info
  198. } {x {} w 0 123 x {} r 0 123 x {} w 0 {123 456}}
  199.  
  200. # Basic unset-tracing on variables
  201.  
  202. test trace-4.1 {trace variable unsets} {
  203.     catch {unset x}
  204.     set info {}
  205.     trace var x u traceScalar
  206.     catch {unset x}
  207.     set info
  208. } {x {} u 1 {can't read "x": no such variable}}
  209. test trace-4.2 {variable mustn't exist during unset trace} {
  210.     catch {unset x}
  211.     set x 1234
  212.     set info {}
  213.     trace var x u traceScalar
  214.     unset x
  215.     set info
  216. } {x {} u 1 {can't read "x": no such variable}}
  217. test trace-4.3 {unset traces mustn't be called during reads and writes} {
  218.     catch {unset x}
  219.     set info {}
  220.     trace var x u traceScalar
  221.     set x 44
  222.     set x
  223.     set info
  224. } {}
  225. test trace-4.4 {trace unsets on array elements} {
  226.     catch {unset x}
  227.     set x(0) 18
  228.     set info {}
  229.     trace var x(1) u traceArray
  230.     catch {unset x(1)}
  231.     set info
  232. } {x 1 u 1 {can't read "x(1)": no such element in array}}
  233. test trace-4.5 {trace unsets on array elements} {
  234.     catch {unset x}
  235.     set x(1) 18
  236.     set info {}
  237.     trace var x(1) u traceArray
  238.     unset x(1)
  239.     set info
  240. } {x 1 u 1 {can't read "x(1)": no such element in array}}
  241. test trace-4.6 {trace unsets on array elements} {
  242.     catch {unset x}
  243.     set x(1) 18
  244.     set info {}
  245.     trace var x(1) u traceArray
  246.     unset x
  247.     set info
  248. } {x 1 u 1 {can't read "x(1)": no such variable}}
  249. test trace-4.7 {trace unsets on whole arrays} {
  250.     catch {unset x}
  251.     set x(1) 18
  252.     set info {}
  253.     trace var x u traceProc
  254.     catch {unset x(0)}
  255.     set info
  256. } {}
  257. test trace-4.8 {trace unsets on whole arrays} {
  258.     catch {unset x}
  259.     set x(1) 18
  260.     set x(2) 144
  261.     set x(3) 14
  262.     set info {}
  263.     trace var x u traceProc
  264.     unset x(1)
  265.     set info
  266. } {x 1 u}
  267. test trace-4.9 {trace unsets on whole arrays} {
  268.     catch {unset x}
  269.     set x(1) 18
  270.     set x(2) 144
  271.     set x(3) 14
  272.     set info {}
  273.     trace var x u traceProc
  274.     unset x
  275.     set info
  276. } {x {} u}
  277.  
  278. # Trace multiple trace types at once.
  279.  
  280. test trace-5.1 {multiple ops traced at once} {
  281.     catch {unset x}
  282.     set info {}
  283.     trace var x rwu traceProc
  284.     catch {set x}
  285.     set x 22
  286.     set x
  287.     set x 33
  288.     unset x
  289.     set info
  290. } {x {} r x {} w x {} r x {} w x {} u}
  291. test trace-5.2 {multiple ops traced on array element} {
  292.     catch {unset x}
  293.     set info {}
  294.     trace var x(0) rwu traceProc
  295.     catch {set x(0)}
  296.     set x(0) 22
  297.     set x(0)
  298.     set x(0) 33
  299.     unset x(0)
  300.     unset x
  301.     set info
  302. } {x 0 r x 0 w x 0 r x 0 w x 0 u}
  303. test trace-5.3 {multiple ops traced on whole array} {
  304.     catch {unset x}
  305.     set info {}
  306.     trace var x rwu traceProc
  307.     catch {set x(0)}
  308.     set x(0) 22
  309.     set x(0)
  310.     set x(0) 33
  311.     unset x(0)
  312.     unset x
  313.     set info
  314. } {x 0 w x 0 r x 0 w x 0 u x {} u}
  315.  
  316. # Check order of invocation of traces
  317.  
  318. test trace-6.1 {order of invocation of traces} {
  319.     catch {unset x}
  320.     set info {}
  321.     trace var x r "traceTag 1"
  322.     trace var x r "traceTag 2"
  323.     trace var x r "traceTag 3"
  324.     catch {set x}
  325.     set x 22
  326.     set x
  327.     set info
  328. } {3 2 1 3 2 1}
  329. test trace-6.2 {order of invocation of traces} {
  330.     catch {unset x}
  331.     set x(0) 44
  332.     set info {}
  333.     trace var x(0) r "traceTag 1"
  334.     trace var x(0) r "traceTag 2"
  335.     trace var x(0) r "traceTag 3"
  336.     set x(0)
  337.     set info
  338. } {3 2 1}
  339. test trace-6.3 {order of invocation of traces} {
  340.     catch {unset x}
  341.     set x(0) 44
  342.     set info {}
  343.     trace var x(0) r "traceTag 1"
  344.     trace var x r "traceTag A1"
  345.     trace var x(0) r "traceTag 2"
  346.     trace var x r "traceTag A2"
  347.     trace var x(0) r "traceTag 3"
  348.     trace var x r "traceTag A3"
  349.     set x(0)
  350.     set info
  351. } {A3 A2 A1 3 2 1}
  352.  
  353. # Check effects of errors in trace procedures
  354.  
  355. test trace-7.1 {error returns from traces} {
  356.     catch {unset x}
  357.     set x 123
  358.     set info {}
  359.     trace var x r "traceTag 1"
  360.     trace var x r traceError
  361.     list [catch {set x} msg] $msg $info
  362. } {1 {can't read "x": trace returned error} {}}
  363. test trace-7.2 {error returns from traces} {
  364.     catch {unset x}
  365.     set x 123
  366.     set info {}
  367.     trace var x w "traceTag 1"
  368.     trace var x w traceError
  369.     list [catch {set x 44} msg] $msg $info
  370. } {1 {can't set "x": trace returned error} {}}
  371. test trace-7.3 {error returns from traces} {
  372.     catch {unset x}
  373.     set x 123
  374.     set info {}
  375.     trace var x w traceError
  376.     list [catch {append x 44} msg] $msg $info
  377. } {1 {can't set "x": trace returned error} {}}
  378. test trace-7.4 {error returns from traces} {
  379.     catch {unset x}
  380.     set x 123
  381.     set info {}
  382.     trace var x u "traceTag 1"
  383.     trace var x u traceError
  384.     list [catch {unset x} msg] $msg $info
  385. } {0 {} 1}
  386. test trace-7.5 {error returns from traces} {
  387.     catch {unset x}
  388.     set x(0) 123
  389.     set info {}
  390.     trace var x(0) r "traceTag 1"
  391.     trace var x r "traceTag 2"
  392.     trace var x r traceError
  393.     trace var x r "traceTag 3"
  394.     list [catch {set x(0)} msg] $msg $info
  395. } {1 {can't read "x(0)": trace returned error} 3}
  396. test trace-7.6 {error returns from traces} {
  397.     catch {unset x}
  398.     set x 123
  399.     trace var x u traceError
  400.     list [catch {unset x} msg] $msg
  401. } {0 {}}
  402. test trace-7.7 {error returns from traces} {
  403.     # This test just makes sure that the memory for the error message
  404.     # gets deallocated correctly when the trace is invoked again or
  405.     # when the trace is deleted.
  406.     catch {unset x}
  407.     set x 123
  408.     trace var x r traceError
  409.     catch {set x}
  410.     catch {set x}
  411.     trace vdelete x r traceError
  412. } {}
  413.  
  414. # Check to see that variables are expunged before trace
  415. # procedures are invoked, so trace procedure can even manipulate
  416. # a new copy of the variables.
  417.  
  418. test trace-8.1 {be sure variable is unset before trace is called} {
  419.     catch {unset x}
  420.     set x 33
  421.     set info {}
  422.     trace var x u {traceCheck {uplevel set x}}
  423.     unset x
  424.     set info
  425. } {1 {can't read "x": no such variable}}
  426. test trace-8.2 {be sure variable is unset before trace is called} {
  427.     catch {unset x}
  428.     set x 33
  429.     set info {}
  430.     trace var x u {traceCheck {uplevel set x 22}}
  431.     unset x
  432.     concat $info [list [catch {set x} msg] $msg]
  433. } {0 22 0 22}
  434. test trace-8.3 {be sure traces are cleared before unset trace called} {
  435.     catch {unset x}
  436.     set x 33
  437.     set info {}
  438.     trace var x u {traceCheck {uplevel trace vinfo x}}
  439.     unset x
  440.     set info
  441. } {0 {}}
  442. test trace-8.4 {set new trace during unset trace} {
  443.     catch {unset x}
  444.     set x 33
  445.     set info {}
  446.     trace var x u {traceCheck {global x; trace var x u traceProc}}
  447.     unset x
  448.     concat $info [trace vinfo x]
  449. } {0 {} {u traceProc}}
  450.  
  451. test trace-9.1 {make sure array elements are unset before traces are called} {
  452.     catch {unset x}
  453.     set x(0) 33
  454.     set info {}
  455.     trace var x(0) u {traceCheck {uplevel set x(0)}}
  456.     unset x(0)
  457.     set info
  458. } {1 {can't read "x(0)": no such element in array}}
  459. test trace-9.2 {make sure array elements are unset before traces are called} {
  460.     catch {unset x}
  461.     set x(0) 33
  462.     set info {}
  463.     trace var x(0) u {traceCheck {uplevel set x(0) zzz}}
  464.     unset x(0)
  465.     concat $info [list [catch {set x(0)} msg] $msg]
  466. } {0 zzz 0 zzz}
  467. test trace-9.3 {array elements are unset before traces are called} {
  468.     catch {unset x}
  469.     set x(0) 33
  470.     set info {}
  471.     trace var x(0) u {traceCheck {global x; trace vinfo x(0)}}
  472.     unset x(0)
  473.     set info
  474. } {0 {}}
  475. test trace-9.4 {set new array element trace during unset trace} {
  476.     catch {unset x}
  477.     set x(0) 33
  478.     set info {}
  479.     trace var x(0) u {traceCheck {uplevel {trace variable x(0) r {}}}}
  480.     catch {unset x(0)}
  481.     concat $info [trace vinfo x(0)]
  482. } {0 {} {r {}}}
  483.  
  484. test trace-10.1 {make sure arrays are unset before traces are called} {
  485.     catch {unset x}
  486.     set x(0) 33
  487.     set info {}
  488.     trace var x u {traceCheck {uplevel set x(0)}}
  489.     unset x
  490.     set info
  491. } {1 {can't read "x(0)": no such variable}}
  492. test trace-10.2 {make sure arrays are unset before traces are called} {
  493.     catch {unset x}
  494.     set x(y) 33
  495.     set info {}
  496.     trace var x u {traceCheck {uplevel set x(y) 22}}
  497.     unset x
  498.     concat $info [list [catch {set x(y)} msg] $msg]
  499. } {0 22 0 22}
  500. test trace-10.3 {make sure arrays are unset before traces are called} {
  501.     catch {unset x}
  502.     set x(y) 33
  503.     set info {}
  504.     trace var x u {traceCheck {uplevel array exists x}}
  505.     unset x
  506.     set info
  507. } {0 0}
  508. test trace-10.4 {make sure arrays are unset before traces are called} {
  509.     catch {unset x}
  510.     set x(y) 33
  511.     set info {}
  512.     set cmd {traceCheck {uplevel {trace vinfo x}}}
  513.     trace var x u $cmd
  514.     unset x
  515.     set info
  516. } {0 {}}
  517. test trace-10.5 {set new array trace during unset trace} {
  518.     catch {unset x}
  519.     set x(y) 33
  520.     set info {}
  521.     trace var x u {traceCheck {global x; trace var x r {}}}
  522.     unset x
  523.     concat $info [trace vinfo x]
  524. } {0 {} {r {}}}
  525. test trace-10.6 {create scalar during array unset trace} {
  526.     catch {unset x}
  527.     set x(y) 33
  528.     set info {}
  529.     trace var x u {traceCheck {global x; set x 44}}
  530.     unset x
  531.     concat $info [list [catch {set x} msg] $msg]
  532. } {0 44 0 44}
  533.  
  534. # Check special conditions (e.g. errors) in Tcl_TraceVar2.
  535.  
  536. test trace-11.1 {creating array when setting variable traces} {
  537.     catch {unset x}
  538.     set info {}
  539.     trace var x(0) w traceProc
  540.     list [catch {set x 22} msg] $msg
  541. } {1 {can't set "x": variable is array}}
  542. test trace-11.2 {creating array when setting variable traces} {
  543.     catch {unset x}
  544.     set info {}
  545.     trace var x(0) w traceProc
  546.     list [catch {set x(0)} msg] $msg
  547. } {1 {can't read "x(0)": no such element in array}}
  548. test trace-11.3 {creating array when setting variable traces} {
  549.     catch {unset x}
  550.     set info {}
  551.     trace var x(0) w traceProc
  552.     set x(0) 22
  553.     set info
  554. } {x 0 w}
  555. test trace-11.4 {creating variable when setting variable traces} {
  556.     catch {unset x}
  557.     set info {}
  558.     trace var x w traceProc
  559.     list [catch {set x} msg] $msg
  560. } {1 {can't read "x": no such variable}}
  561. test trace-11.5 {creating variable when setting variable traces} {
  562.     catch {unset x}
  563.     set info {}
  564.     trace var x w traceProc
  565.     set x 22
  566.     set info
  567. } {x {} w}
  568. test trace-11.6 {creating variable when setting variable traces} {
  569.     catch {unset x}
  570.     set info {}
  571.     trace var x w traceProc
  572.     set x(0) 22
  573.     set info
  574. } {x 0 w}
  575. test trace-11.7 {create array element during read trace} {
  576.     catch {unset x}
  577.     set x(2) zzz
  578.     trace var x r {traceCrtElement xyzzy}
  579.     list [catch {set x(3)} msg] $msg
  580. } {0 xyzzy}
  581. test trace-11.8 {errors when setting variable traces} {
  582.     catch {unset x}
  583.     set x 44
  584.     list [catch {trace var x(0) w traceProc} msg] $msg
  585. } {1 {can't trace "x(0)": variable isn't array}}
  586.  
  587. # Check deleting one trace from another.
  588.  
  589. test trace-12.1 {delete one trace from another} {
  590.     proc delTraces {args} {
  591.     global x
  592.     trace vdel x r {traceTag 2}
  593.     trace vdel x r {traceTag 3}
  594.     trace vdel x r {traceTag 4}
  595.     }
  596.     catch {unset x}
  597.     set x 44
  598.     set info {}
  599.     trace var x r {traceTag 1}
  600.     trace var x r {traceTag 2}
  601.     trace var x r {traceTag 3}
  602.     trace var x r {traceTag 4}
  603.     trace var x r delTraces 
  604.     trace var x r {traceTag 5}
  605.     set x
  606.     set info
  607. } {5 1}
  608.  
  609. # Check operation and syntax of "trace" command.
  610.  
  611. test trace-13.1 {trace command (overall)} {
  612.     list [catch {trace} msg] $msg
  613. } {1 {too few args: should be "trace option [arg arg ...]"}}
  614. test trace-13.2 {trace command (overall)} {
  615.     list [catch {trace gorp} msg] $msg
  616. } {1 {bad option "gorp": should be variable, vdelete, or vinfo}}
  617. test trace-13.3 {trace command ("variable" option)} {
  618.     list [catch {trace variable x y} msg] $msg
  619. } {1 {wrong # args: should be "trace variable name ops command"}}
  620. test trace-13.4 {trace command ("variable" option)} {
  621.     list [catch {trace var x y z z2} msg] $msg
  622. } {1 {wrong # args: should be "trace variable name ops command"}}
  623. test trace-13.5 {trace command ("variable" option)} {
  624.     list [catch {trace var x y z} msg] $msg
  625. } {1 {bad operations "y": should be one or more of rwu}}
  626. test trace-13.6 {trace command ("vdelete" option)} {
  627.     list [catch {trace vdelete x y} msg] $msg
  628. } {1 {wrong # args: should be "trace vdelete name ops command"}}
  629. test trace-13.7 {trace command ("vdelete" option)} {
  630.     list [catch {trace vdelete x y z foo} msg] $msg
  631. } {1 {wrong # args: should be "trace vdelete name ops command"}}
  632. test trace-13.8 {trace command ("vdelete" option)} {
  633.     list [catch {trace vdelete x y z} msg] $msg
  634. } {1 {bad operations "y": should be one or more of rwu}}
  635. test trace-13.9 {trace command ("vdelete" option)} {
  636.     catch {unset x}
  637.     set info {}
  638.     trace var x w traceProc
  639.     trace vdelete x w traceProc
  640. } {}
  641. test trace-13.10 {trace command ("vdelete" option)} {
  642.     catch {unset x}
  643.     set info {}
  644.     trace var x w traceProc
  645.     trace vdelete x w traceProc
  646.     set x 12345
  647.     set info
  648. } {}
  649. test trace-13.11 {trace command ("vdelete" option)} {
  650.     catch {unset x}
  651.     set info {}
  652.     trace var x w {traceTag 1}
  653.     trace var x w traceProc
  654.     trace var x w {traceTag 2}
  655.     set x yy
  656.     trace vdelete x w traceProc
  657.     set x 12345
  658.     trace vdelete x w {traceTag 1}
  659.     set x foo
  660.     trace vdelete x w {traceTag 2}
  661.     set x gorp
  662.     set info
  663. } {2 x {} w 1 2 1 2}
  664. test trace-13.12 {trace command ("vdelete" option)} {
  665.     catch {unset x}
  666.     set info {}
  667.     trace var x w {traceTag 1}
  668.     trace vdelete x w non_existent
  669.     set x 12345
  670.     set info
  671. } {1}
  672. test trace-13.13 {trace command ("vinfo" option)} {
  673.     list [catch {trace vinfo} msg] $msg]
  674. } {1 {wrong # args: should be "trace vinfo name"]}}
  675. test trace-13.14 {trace command ("vinfo" option)} {
  676.     list [catch {trace vinfo x y} msg] $msg]
  677. } {1 {wrong # args: should be "trace vinfo name"]}}
  678. test trace-13.15 {trace command ("vinfo" option)} {
  679.     catch {unset x}
  680.     trace var x w {traceTag 1}
  681.     trace var x w traceProc
  682.     trace var x w {traceTag 2}
  683.     trace vinfo x
  684. } {{w {traceTag 2}} {w traceProc} {w {traceTag 1}}}
  685. test trace-13.16 {trace command ("vinfo" option)} {
  686.     catch {unset x}
  687.     trace vinfo x
  688. } {}
  689. test trace-13.17 {trace command ("vinfo" option)} {
  690.     catch {unset x}
  691.     trace vinfo x(0)
  692. } {}
  693. test trace-13.18 {trace command ("vinfo" option)} {
  694.     catch {unset x}
  695.     set x 44
  696.     trace vinfo x(0)
  697. } {}
  698. test trace-13.19 {trace command ("vinfo" option)} {
  699.     catch {unset x}
  700.     set x 44
  701.     trace var x w {traceTag 1}
  702.     proc check {} {global x; trace vinfo x}
  703.     check
  704. } {{w {traceTag 1}}}
  705.  
  706. # Check fancy trace commands (long ones, weird arguments, etc.)
  707.  
  708. test trace-14.1 {long trace command} {
  709.     catch {unset x}
  710.     set info {}
  711.     trace var x w {traceTag {This is a very very long argument.  It's \
  712.     designed to test out the facilities of TraceVarProc for dealing \
  713.     with such long arguments by malloc-ing space.  One possibility \
  714.     is that space doesn't get freed properly.  If this happens, then \
  715.     invoking this test over and over again will eventually leak memory.}}
  716.     set x 44
  717.     set info
  718. } {This is a very very long argument.  It's \
  719.     designed to test out the facilities of TraceVarProc for dealing \
  720.     with such long arguments by malloc-ing space.  One possibility \
  721.     is that space doesn't get freed properly.  If this happens, then \
  722.     invoking this test over and over again will eventually leak memory.}
  723. test trace-14.2 {long trace command result to ignore} {
  724.     proc longResult {args} {return "quite a bit of text, designed to
  725.     generate a core leak if this command file is invoked over and over again
  726.     and memory isn't being recycled correctly"}
  727.     catch {unset x}
  728.     trace var x w longResult
  729.     set x 44
  730.     set x 5
  731.     set x abcde
  732. } abcde
  733. test trace-14.3 {special list-handling in trace commands} {
  734.     catch {unset "x y z"}
  735.     set "x y z(a\n\{)" 44
  736.     set info {}
  737.     trace var "x y z(a\n\{)" w traceProc
  738.     set "x y z(a\n\{)" 33
  739.     set info
  740. } "{x y z} a\\n\\{ w"
  741.  
  742. # Check for proper handling of unsets during traces.
  743.  
  744. proc traceUnset {unsetName args} {
  745.     global info
  746.     upvar $unsetName x
  747.     lappend info [catch {unset x} msg] $msg [catch {set x} msg] $msg
  748. }
  749. proc traceReset {unsetName resetName args} {
  750.     global info
  751.     upvar $unsetName x $resetName y
  752.     lappend info [catch {unset x} msg] $msg [catch {set y xyzzy} msg] $msg
  753. }
  754. proc traceReset2 {unsetName resetName args} {
  755.     global info
  756.     lappend info [catch {uplevel unset $unsetName} msg] $msg \
  757.         [catch {uplevel set $resetName xyzzy} msg] $msg
  758. }
  759. proc traceAppend {string name1 name2 op} {
  760.     global info
  761.     lappend info $string
  762. }
  763.  
  764. test trace-15.1 {unsets during read traces} {
  765.     catch {unset y}
  766.     set y 1234
  767.     set info {}
  768.     trace var y r {traceUnset y}
  769.     trace var y u {traceAppend unset}
  770.     lappend info [catch {set y} msg] $msg
  771. } {unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}}
  772. test trace-15.2 {unsets during read traces} {
  773.     catch {unset y}
  774.     set y(0) 1234
  775.     set info {}
  776.     trace var y(0) r {traceUnset y(0)}
  777.     lappend info [catch {set y(0)} msg] $msg
  778. } {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such element in array}}
  779. test trace-15.3 {unsets during read traces} {
  780.     catch {unset y}
  781.     set y(0) 1234
  782.     set info {}
  783.     trace var y(0) r {traceUnset y}
  784.     lappend info [catch {set y(0)} msg] $msg
  785. } {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such variable}}
  786. test trace-15.4 {unsets during read traces} {
  787.     catch {unset y}
  788.     set y 1234
  789.     set info {}
  790.     trace var y r {traceReset y y}
  791.     lappend info [catch {set y} msg] $msg
  792. } {0 {} 0 xyzzy 0 xyzzy}
  793. test trace-15.5 {unsets during read traces} {
  794.     catch {unset y}
  795.     set y(0) 1234
  796.     set info {}
  797.     trace var y(0) r {traceReset y(0) y(0)}
  798.     lappend info [catch {set y(0)} msg] $msg
  799. } {0 {} 0 xyzzy 0 xyzzy}
  800. test trace-15.6 {unsets during read traces} {
  801.     catch {unset y}
  802.     set y(0) 1234
  803.     set info {}
  804.     trace var y(0) r {traceReset y y(0)}
  805.     lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg
  806. } {0 {} 1 {can't set "y": upvar refers to element in deleted array} 1 {can't read "y(0)": no such variable} 1 {can't read "y(0)": no such variable}}
  807. test trace-15.7 {unsets during read traces} {
  808.     catch {unset y}
  809.     set y(0) 1234
  810.     set info {}
  811.     trace var y(0) r {traceReset2 y y(0)}
  812.     lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg
  813. } {0 {} 0 xyzzy 1 {can't read "y(0)": no such element in array} 0 xyzzy}
  814. test trace-15.8 {unsets during write traces} {
  815.     catch {unset y}
  816.     set y 1234
  817.     set info {}
  818.     trace var y w {traceUnset y}
  819.     trace var y u {traceAppend unset}
  820.     lappend info [catch {set y xxx} msg] $msg
  821. } {unset 0 {} 1 {can't read "x": no such variable} 0 {}}
  822. test trace-15.9 {unsets during write traces} {
  823.     catch {unset y}
  824.     set y(0) 1234
  825.     set info {}
  826.     trace var y(0) w {traceUnset y(0)}
  827.     lappend info [catch {set y(0) xxx} msg] $msg
  828. } {0 {} 1 {can't read "x": no such variable} 0 {}}
  829. test trace-15.10 {unsets during write traces} {
  830.     catch {unset y}
  831.     set y(0) 1234
  832.     set info {}
  833.     trace var y(0) w {traceUnset y}
  834.     lappend info [catch {set y(0) xxx} msg] $msg
  835. } {0 {} 1 {can't read "x": no such variable} 0 {}}
  836. test trace-15.11 {unsets during write traces} {
  837.     catch {unset y}
  838.     set y 1234
  839.     set info {}
  840.     trace var y w {traceReset y y}
  841.     lappend info [catch {set y xxx} msg] $msg
  842. } {0 {} 0 xyzzy 0 xyzzy}
  843. test trace-15.12 {unsets during write traces} {
  844.     catch {unset y}
  845.     set y(0) 1234
  846.     set info {}
  847.     trace var y(0) w {traceReset y(0) y(0)}
  848.     lappend info [catch {set y(0) xxx} msg] $msg
  849. } {0 {} 0 xyzzy 0 xyzzy}
  850. test trace-15.13 {unsets during write traces} {
  851.     catch {unset y}
  852.     set y(0) 1234
  853.     set info {}
  854.     trace var y(0) w {traceReset y y(0)}
  855.     lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg
  856. } {0 {} 1 {can't set "y": upvar refers to element in deleted array} 0 {} 1 {can't read "y(0)": no such variable}}
  857. test trace-15.14 {unsets during write traces} {
  858.     catch {unset y}
  859.     set y(0) 1234
  860.     set info {}
  861.     trace var y(0) w {traceReset2 y y(0)}
  862.     lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg
  863. } {0 {} 0 xyzzy 0 {} 0 xyzzy}
  864. test trace-15.15 {unsets during unset traces} {
  865.     catch {unset y}
  866.     set y 1234
  867.     set info {}
  868.     trace var y u {traceUnset y}
  869.     lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg
  870. } {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y": no such variable}}
  871. test trace-15.16 {unsets during unset traces} {
  872.     catch {unset y}
  873.     set y(0) 1234
  874.     set info {}
  875.     trace var y(0) u {traceUnset y(0)}
  876.     lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
  877. } {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such element in array}}
  878. test trace-15.17 {unsets during unset traces} {
  879.     catch {unset y}
  880.     set y(0) 1234
  881.     set info {}
  882.     trace var y(0) u {traceUnset y}
  883.     lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
  884. } {0 {} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such variable}}
  885. test trace-15.18 {unsets during unset traces} {
  886.     catch {unset y}
  887.     set y 1234
  888.     set info {}
  889.     trace var y u {traceReset2 y y}
  890.     lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg
  891. } {1 {can't unset "y": no such variable} 0 xyzzy 0 {} 0 xyzzy}
  892. test trace-15.19 {unsets during unset traces} {
  893.     catch {unset y}
  894.     set y(0) 1234
  895.     set info {}
  896.     trace var y(0) u {traceReset2 y(0) y(0)}
  897.     lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
  898. } {1 {can't unset "y(0)": no such element in array} 0 xyzzy 0 {} 0 xyzzy}
  899. test trace-15.20 {unsets during unset traces} {
  900.     catch {unset y}
  901.     set y(0) 1234
  902.     set info {}
  903.     trace var y(0) u {traceReset2 y y(0)}
  904.     lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
  905. } {0 {} 0 xyzzy 0 {} 0 xyzzy}
  906. test trace-15.21 {unsets cancelling traces} {
  907.     catch {unset y}
  908.     set y 1234
  909.     set info {}
  910.     trace var y r {traceAppend first}
  911.     trace var y r {traceUnset y}
  912.     trace var y r {traceAppend third}
  913.     trace var y u {traceAppend unset}
  914.     lappend info [catch {set y} msg] $msg
  915. } {third unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}}
  916. test trace-15.22 {unsets cancelling traces} {
  917.     catch {unset y}
  918.     set y(0) 1234
  919.     set info {}
  920.     trace var y(0) r {traceAppend first}
  921.     trace var y(0) r {traceUnset y}
  922.     trace var y(0) r {traceAppend third}
  923.     trace var y(0) u {traceAppend unset}
  924.     lappend info [catch {set y(0)} msg] $msg
  925. } {third unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such variable}}
  926.  
  927. # Check various non-interference between traces and other things.
  928.  
  929. test trace-16.1 {trace doesn't prevent unset errors} {
  930.     catch {unset x}
  931.     set info {}
  932.     trace var x u {traceProc}
  933.     list [catch {unset x} msg] $msg $info
  934. } {1 {can't unset "x": no such variable} {x {} u}}
  935. test trace-16.2 {traced variables must survive procedure exits} {
  936.     catch {unset x}
  937.     proc p1 {} {global x; trace var x w traceProc}
  938.     p1
  939.     trace vinfo x
  940. } {{w traceProc}}
  941. test trace-16.3 {traced variables must survive procedure exits} {
  942.     catch {unset x}
  943.     set info {}
  944.     proc p1 {} {global x; trace var x w traceProc}
  945.     p1
  946.     set x 44
  947.     set info
  948. } {x {} w}
  949.  
  950. # Be sure that procedure frames are released before unset traces
  951. # are invoked.
  952.  
  953. test trace-17.1 {unset traces on procedure returns} {
  954.     proc p1 {x y} {set a 44; p2 14}
  955.     proc p2 {z} {trace var z u {traceCheck {lsort [uplevel {info vars}]}}}
  956.     set info {}
  957.     p1 foo bar
  958.     set info
  959. } {0 {a x y}}
  960.  
  961. # Delete arrays when done, so they can be re-used as scalars
  962. # elsewhere.
  963.  
  964. catch {unset x}
  965. catch {unset y}
  966. concat {}
  967.